home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1995 November
/
EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso
/
earcd
/
dbase
/
scion409.lha
/
Scion409
/
ScionARexx.lha
/
PersonInfo.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-10-25
|
9KB
|
322 lines
/****************************************************************************/
/* */
/* PersonInfo.rexx */
/* */
/* Written by: Peter Billing, RMB 1240, Yinnar 3869, Australia */
/* */
/* Last saved: Wednesday 29-Sep-93 */
/* */
/* This program should print out information about a person in the SCION */
/* database. The database must be running for this AREXX script to work. */
/* */
/****************************************************************************/
/* Return the Database Name */
options results
/*test = show('P','SCIONGEN')
if test = 0 then
say
say "I am sorry to say that the SCION Genealogist database is not available."
say "Please start the SCION program BEFORE using this script."
say
exit */
myport = "SCIONGEN"
address value myport
getdbname
dbname = upper(result)
output = "STDOUT"
writeln(output, "")
writeln(output,center("This script will give you a",80))
heading = "Listing of a Person in the" dbname "database on" date()
writeln(output,center(heading,80))
writech(output,"Type in the IRN of the Person you require or ALL for all. " )
pull irn
gettotalirn
total = result
if irn = "ALL" then do
writech(stdout,"Do you want a sorted list Y/N ")
pull sorted
if sorted = "" then sorted = "N"
start = 1
finish = total
end
if irn ~= "ALL" then do
start = irn
finish = irn
end
if irn ~= "ALL" & irn > total then do
say "I am sorry to say that there are only" total "people available. "
exit
end
writech(output, "Output to Screen or File S/F ")
pull out
if out = "" then out = "S"
if sorted = "Y" then do
file_name = "ram:sort"
open(sort_File,file_Name,"w")
do a = 1 to total
getlastname a
person = upper(result)
getfirstname a
person = person result a
writeln(sort_File,person)
end
close(sort_file)
address command "c:sort ram:sort ram:sort2"
file_name = "ram:sort2"
open(sort_File,file_Name,"r")
end
output = "STDOUT"
code1 = "
" /* Bold */
code2 = "" /* Normal */
if out = "F" then do
code1 = "
" /* Bold on */
code2 = "
" /* Bold off */
filename = "RAM:PersonInfo_"dbname"_"irn".Scion"
open(w_file,filename,"w")
output = w_file
writeln(stdout,"")
writeln(stdout,"Writing file to" filename)
end
heading = "Personal information in the" dbname "database on" date()
do j = start to finish
if sorted = "Y" then do
person = readln(sort_file)
p = word(person,words(person))
end
else do
p = j
end
if out = "F" then do
if (j+2)/3 = (j+2)%3 then do
writech(stdout,".")
if j ~= 1 then do
writeln(output,"--------------------------------------------------------------------------------")
writech(output,"")
end
writeln(output,center(heading,80))
end
end
getlastname p
name = code1 left(result,15)code2
getfirstname p
name = name left(result,25)
principal = name
sp = 3
getsex p
sex = result
getage(p)
writeln(output,"================================================================================")
writeln(output,principal " ["p"] Sex:" sex " Age:" age Life)
writeln(output,"--------------------------------------------------------------------------------")
getbirthdate p
birthdate = result
getbirthplace p
birthplace = result
writeln(output,right(" ",sp)left("Born:",12) right(birthdate,14) right("Place:",8) birthplace)
writeln(output,right(" ",sp)left("Christened:",12) right(" ",14) right("Place:",8))
getdeathdate p
deathdate = result
getdeathplace p
deathplace = result
writeln(output,right(" ",sp)left("Died:",12) right(deathdate,14) right("Place:",8) deathplace)
getburialdate p
burialdate = result
getburialplace p
burialplace = result
writeln(output,right(" ",sp)left("Buried:",12) right(burialdate,14) right("Place:",8) burialplace)
getpersuser1 p
user1 = result
writeln(output,right(" ",sp)left("Occupation:",12) user1)
getpersuser2 p
user2 = result
writeln(output,right(" ",sp)left("Comments:",12) user2)
getpersuser3 p
user3 = result
writeln(output,right(" ",sp)left("References:",12) user3)
getparents p
parents = result
getprincipal parents
p1 = result
MakeName(p1)
principalParent = name
getspouse parents
s1 = result
MakeName(s1)
spouseParent = name
getsex s1
if result = "M" then do
temp = spouseParent
spouseParent = principalParent
principalParent = temp
t1 = s1
s1 = p1
p1 = t1
end
writeln(output,right(" ",sp)left("Parents:",12) PrincipalParent "["p1"]")
writeln(output,right(" ",sp)right(" ",12) SpouseParent "["s1"]")
getmarriage p 0
fgrn = result
getspouse fgrn
s = result
getsex s
if sex = result then do
getprincipal fgrn
s = result
end
MakeName(s)
spouse = name
writeln(output,"--------------------------------------------------------------------------------")
writech(output,right(" ",sp)left("Spouse:",12) spouse)
if fgrn ~= "" then do
writeln(output, "["s"]")
end
else do
writeln(output,"")
end
getmarrydate fgrn
marrydate = result
getmarryplace fgrn
marryplace = result
writeln(output,right(" ",sp)left("Married:",12) right(marrydate,14) right("Place:",8) marryplace)
getfamuser1 fgrn
user1 = result
writeln(output,right(" ",sp)left("Celebrant:",12) user1)
getfamuser2 fgrn
user2 = result
writeln(output,right(" ",sp)left("Comments:",12) user2)
/* writeln(output,"--------------------------------------------------------------------------------") */
writech(output,right(" ",sp)"Other Marriages: ")
fix = 0
do m = 0 to 9
getmarriage p m
if result ~= "" & result ~= fgrn then do /* only display marriages apart */
/* from the present */
writech(output," ["result"]")
fix = 1
end
end
if fix = 1 then writeln(output,"")
else
writeln(output," None recorded.")
writech(output,right(" ",sp)"Children:")
fix = 0
if fgrn ~= "" then do
do c = 0 to 39
getchild fgrn c
if result ~= "" then do
writech(output," ["result"]")
fix = 1
end
end
end
if fix = 1 then writeln(output,"")
else
writeln(output," None recorded.")
end
if out = "F" then do
writeln(output,"")
close(w_file)
writeln(stdout,"")
writeln(stdout,"All Finished")
end
exit
MakeName:
parse arg irn
getfirstname irn
name = left(result,25)code1
getlastname irn
name = name left(result,15)code2
return name
GetAge:
parse arg irn
age = ""
life = ""
day1 = substr(date(),1,2)
Month1 = substr(date(),4,3)
Year1 = substr(date(),8,4)
CheckMonth(upper(Month1)) /* turn the month into a number */
m1 = x
birth = ""
getbirthdate irn
birth = result
if birth ~= "" then do
if length(birth) > 3 then do /* check if there is a date */
day2 = word(birth,1) /* if there is then continue */
Month2 = substr(word(birth,2),1,3)
Year2 = substr(birth,length(birth)-3,4)
CheckMonth(upper(Month2))
m2 = x
end
else do /* no date */
break /* no need going any futher */
end
death = ""
getdeathdate irn
death = result
if length(death) > 3 then do /* is if the person has a death date */
day3 = word(death,1) /* if there is a date then work out */
Month3 = word(death,2) /* age at death */
Year3 = substr(death,length(death)-3,4)
CheckMonth(upper(Month3))
m3 = x
age = year3 - year2
if m3 < m2 then age = age -1
if m3 = m2 then do
if day3 < day2 then age = age -1
end
Life = "D"
end
/* Person is still alive */
if length(death) < 3 & length(birth) > 3 then do /* check there is a bith date */
age = year1 - year2 /* work out the age using the year */
Life = "L"
if m1 < m2 then /* if birth month is less than today */
age = age -1 /* then person is a year younger */
if m1 = m2 then do /* if the months are the same then */
/* check the days */
if day1 < day2 then do /* if birth day is less than today */
age = age -1 /* then person is a year younger */
end
end
end
if age > 105 then do
age = ""
Life = ""
end
end
return age
CheckMonth:
parse arg m
if m = "JAN" then x = 1
if m = "FEB" then x = 2
if m = "MAR" then x = 3
if m = "APR" then x = 4
if m = "MAY" then x = 5
if m = "JUN" then x = 6
if m = "JUL" then x = 7
if m = "AUG" then x = 8
if m = "SEP" then x = 9
if m = "OCT" then x = 10
if m = "NOV" then x = 11
if m = "DEC" then x = 12
return x